home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Asm Source / toplevel < prev   
Encoding:
Text File  |  1995-07-05  |  3.6 KB  |  190 lines  |  [TEXT/MSET]
  1. \ Assembler            ReeseWarner            3/85
  2. \  02/28/86  GDC  Fixed :MCODE
  3. \  Feb 88    MRH  Revised main control loop
  4. \  Apr 88    MRH  Ensure base is decimal for InitASM
  5.  
  6. 0 -> dlevel
  7.  
  8. 0 value endLen
  9. 0 value endAddr
  10.  
  11. : MOVEBACK
  12.     addr: topFile  3  charCount negate (lseek) drop  ;
  13.  
  14.  
  15. : INITP     { #pass -- }
  16.     #pass -> pass
  17.     0 -> charCount
  18.     tiblen -> pos
  19.     0 -> linect
  20.     0 -> codePos
  21.     0 -> errflag
  22.     0 -> storedToken  ;
  23.  
  24.  
  25. \ Eliminates any blank lines
  26. : KILLEOLS  ( -- )
  27.     BEGIN
  28.         nextToken 4 =
  29.     NUNTIL  ;
  30.  
  31.  
  32. : DOMIDDLE
  33.     msg" top"
  34.     errflag
  35.     IF                        \ if error then 
  36.         211 asmError        \    abort
  37.         abort
  38.     ELSE                    \ else
  39.         moveBack            \    set up pass 2
  40.         2 initP
  41.     THEN  ;
  42.  
  43.  
  44. false    value    ENDFLAG
  45.  
  46. : MORE?
  47.     endFlag
  48.     IF                        \ if end flag then
  49.         false                \    get out of loop
  50.     ELSE                    \ else
  51. \        KillEols            \    get rid of blank lines
  52.         start: token        \    get a token
  53.         EndAddr EndLen get: token s= not val" ENDflag F=Found"
  54.     THEN   ;                \    if end of asm code then exit
  55.  
  56. : HANDLE_OPCODE  { mnemonic -- }
  57.     opFmt: [ mnemonic ] -> opFmt    \ Default format for this opcode
  58.     mnemonic val" final mnemonic is"
  59.     dup 0=  -> endFlag
  60.     IF
  61.         getFormat    \ Replace opFmt with explicit format if any
  62.         pass 1 =
  63.         IF
  64.             length: [ mnemonic ]
  65.             \ dup . cr        \ for debugging
  66.             ++> codePos        \ add length to codepos
  67.         ELSE
  68.             here -> keephere     \ builds bit codes
  69.             build: [ mnemonic ]
  70.             here keephere - ++> codePos
  71.         THEN
  72.     THEN  ;
  73.  
  74. : ENTERLABEL
  75.     token  query: symtab
  76.     nilP <> IF  253 asmError  THEN        \ Error if already defined
  77.     ['] var  newObj: tempH
  78.     codePos 2*  here +  obj: tempH  put: **
  79.     tempH token  enter: symtab  unlock: tempH  ;
  80.  
  81.  
  82. : HANDLE_LABEL
  83.     msg" It's a label!"
  84.     nextToken drop
  85.     pass 1 = IF  enterLabel  THEN  ;
  86.  
  87.  
  88. : HANDLE_REST  { \ mnemonic opc_found? -- }
  89.     nextToken eol =  ?EXIT        \ Out if nothing else on line
  90.     EndAddr EndLen get: token s= val" ENDflag T=Found"
  91.     -> endFlag
  92.     endFlag  ?EXIT            \ Out if assembly finished
  93.     token query: codes -> opc_found?
  94.     opc_found?
  95.     IF
  96.         -> mnemonic
  97.     ELSE
  98.         252 asmError        \ Undefined opcode
  99.     THEN
  100.     opc_found?
  101.     IF
  102.         mnemonic  handle_opcode
  103.     THEN  ;
  104.  
  105.  
  106. \ Assemble instructions, main control loop
  107.  
  108.     0    value    SEC#
  109.  
  110. : ASM
  111.     false -> endFlag
  112.     BEGIN                    \ Loop over all input lines
  113.         endFlag
  114.     NWHILE
  115.         getline
  116.         0 -> storedToken
  117.         label_there?
  118.         IF
  119.             handle_label  false -> label_there?
  120.         THEN
  121.         handle_rest
  122.     REPEAT
  123.     pass 1 =
  124.     IF
  125.         doMiddle
  126.         asm        \ Recursive call
  127.     THEN  ;
  128.  
  129. true    value    INITASM? 
  130.  
  131. : InitASM
  132.     new: token  ;
  133.  
  134. : EndASM
  135.     initAsm?  0EXIT
  136.     release: symTab  release: token
  137.     true -> initAsm?  ;
  138.  
  139.  
  140. : WINDUP    \ Winds up the assembly of one definition.
  141.     (Frefill) drop            \ Gobble the ;code or ;mcode line
  142.     errflag  IF  3 beep 3 beep abort  THEN
  143.     (;)  sec# ?defn  ;
  144.  
  145.  
  146. : (CODE)
  147.     initAsm? IF initASM THEN
  148.     1 initP
  149.     asm
  150.     windup  ;
  151.  
  152.  
  153. : TOCODE        \ Exported. Switches to assembly within a definition.
  154.     " ;CODE"  -> endLen  -> endAddr
  155.     310 dup -> sec#            \ Security check
  156.     (code)  ;        immediate
  157.  
  158. : :CODE        \ Exported. Begins compilation of code word.
  159.  
  160.     " ;CODE" -> endLen -> endAddr
  161.     310 dup -> sec#            \ Security check
  162.     code                    \ Start a code definition
  163.     (code)  ;
  164.  
  165.  
  166. \ :MCODE - word exported to dictionary. Begins compilation of code method.
  167.  
  168. : :MCODE  { \ selID -- }
  169.     true -> method?
  170.     ?class  311 dup -> sec#        \ Security check
  171.     " ;MCODE" -> endLen -> endAddr
  172.     getSelect -> selID
  173. \    selID ^class 4 (findm)        \ is method already defined?
  174. \    IF
  175. \        warnings?
  176. \        IF
  177. \            cr  0 -> out  here count type
  178. \            ."  redefined as code"
  179. \        THEN
  180. \        ^class >  ?error 183    \ if in same class, error
  181. \        drop
  182. \    THEN
  183.     selID m_header            \ Build method header
  184.     (code)  ;
  185.  
  186.  
  187. " Operands" loadOps        \ get operands in "operands"
  188. " AsmCodes" loadcodes        \ get opcode codes in AsmCodes
  189. ' endAsm  setRelease
  190.